' Used for GetCursor - gets mouse location in screen coordinates.
'
Type POINTAPI
X As Integer
Y As Integer
End Type
'
' Used by WM_SYSCOMMAND - converts mouse location.
'
Type ConvertPOINTAPI
xy As Long
End Type
'
' .INI File Type - holds application .INI file information
'
Type INI_FILE_TYPE
fTop As Single
fLeft As Single
nStyle As Integer
lColor As Long
nGrab As Integer
End Type
'
' Screen Size Type - holds screen size info
'
Type SCREEN_SIZE_TYPE
fVGA_HEIGHT As Single
fVGA_WIDTH As Single
fSVGA_HEIGHT As Single
fSVGA_WIDTH As Single
f1024_HEIGHT As Single
f1024_WIDTH As Single
End Type
'
' Screen Rectangle type for API calls
'
Type lrect
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
'
' API Calls
'
'
' Send Windows Message
'
Declare Function SendmessageByNum Lib "User" Alias "SendMessage" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As Integer
'
' Get Cursor Position
'
Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
'
' Set Window Position
'
Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal CX As Integer, ByVal CY As Integer, ByVal wFlags As Integer) As Integer
'
' .INI File Functions
'
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
'
' Screen Capture Functions
'
Declare Function GetDesktopWindow Lib "User" () As Integer
Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As lrect)
'
' System Menu API Declarations
'
Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
'
' Module Constants
'
'
' For SetWindowPos API Call
'
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const Flags = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const HWND_BOTTOM = 1
Const HWND_TOP = 0
'
' .INI file constants
'
Const INI_FILENAME = "SCRNTEST.INI"
Const MAX_INI_STRING = 255
'
' System Menu Constants
'
Const MF_SEPARATOR = &H800
Const MF_STRING = &H0
Const MF_ENABLED = 0
Const MF_BYCOMMAND = &H0
Const MF_UNCHECKED = &H0
Const MF_CHECKED = &H8
Const MF_BYPOSITION = &H400
'
' Move Window Message
'
Const SC_MOVE = &HF010
'
' Global Constants
'
'
' For Window Movement API calls
'
Global Const WM_LBUTTONUP = &H202
Global Const WM_SYSCOMMAND = &H112
Global Const MOUSE_MOVE = &HF012
'
' Standard VB Keyboard Constants
'
Global Const ALT_MASK = 4
Global Const KEY_F4 = &H73
Global Const KEY_LBUTTON = &H1
Global Const KEY_RBUTTON = &H2
Global Const KEY_HOME = &H24
Global Const KEY_LEFT = &H25
Global Const KEY_UP = &H26
Global Const KEY_RIGHT = &H27
Global Const KEY_DOWN = &H28
'
' Standard VB WindowState Constant
'
Global Const NORMAL = 0
Global Const MINIMIZED = 1
'
' Constants for PlaceDialog Subroutine
'
Global Const DLG_STANDARD = 0
Global Const DLG_CENTERED = 1
'
' MsgBox Warning message Constant
'
Global Const MB_ICONEXCLAMATION = 48
'
' Form Show Constants
'
Global Const MODELESS = 0
Global Const MODAL = 1
'
' Style Constants (numbers should match menu control arrray on frmUtility)
'
Global Const STYLE_VGA = 0
Global Const STYLE_SVGA = 1
Global Const STYLE_1024 = 2
'
' Module Variables
'
'
' Throwaway Return variable
'
Dim r As Variant
'
' INI variable
'
Dim muINIVals As INI_FILE_TYPE
'
' Screen pixel/size type
'
Dim muScreenVals As SCREEN_SIZE_TYPE
Sub ExitProgram ()
'
' Centralized Exit from program that saves .INI values
' and makes sure that all forms are unloaded prior to
' ending
'
Dim iLoop As Integer
SaveINIValues
For iLoop = Forms.Count - 1 To 0 Step -1
Unload Forms(iLoop)
Next
End
End Sub
Sub GetINIValues ()
'
' Gets INI values from File
' (all Topic|Section and Default values are hard coded)
MsgBox "The following error occured while attempting to save screen picture:" & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & Error$, MB_ICONEXCLAMATION, "File Save Error"
End If
End If
frmUtility!dlgUtility.CancelError = False
SendFormToBack frmMain
End Sub
Sub SaveScreenPosition ()
'
' Saves Screen Position prior to minimize or after a move.
'
muINIVals.fTop = frmMain.Top
muINIVals.fLeft = frmMain.Left
End Sub
Sub SendFormToBack (frm As Form)
'
' Places form at the lowest in the Zorder
'
r = SetWindowPos(frm.hWnd, HWND_BOTTOM, 0, 0, 0, 0, Flags)
End Sub
Sub SetDestCheck (Index As Integer)
'
' Toggle the Check mark on the screen capture
' destination menu choices
'
Dim iLoop As Integer
For iLoop = 0 To 1
If iLoop = Index Then
frmUtility!mnuPDDestOpt(iLoop).Checked = True
Else
frmUtility!mnuPDDestOpt(iLoop).Checked = False
End If
Next
SaveGrab Index
End Sub
Sub SetDialogMenu (frm As Form)
'
' Removes menu items from the System menu of the specified Form (frm)
' to achieve a standard dialog look.
'
' ****> MaxButton and MinButton properties must be False and the form's borderstyle must be
' ****> Fixed Double in order to achieve the correct effect. This will
' ****> remove all but the MOVE and CLOSE options from the system menu.
